home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / StyleTagAdd.pdrx < prev    next >
Text File  |  1992-06-15  |  3KB  |  150 lines
  1. /*
  2. @N
  3.  
  4. @LThis Genie will add a set of object attributes to a Styles database on disk.
  5. The Attributes may come from the current settings or from settings specified by the user
  6. */
  7. msg = PDSetup.rexx(2,0)
  8. units = getclip(pds_units)
  9. if msg ~= 1 then exit_msg(msg)
  10.  
  11. cr = '0a'x
  12. styledb    = "S:PDStyles.db"
  13. delimiter = "**********"
  14.  
  15. /*    initialize variables        */
  16. linecolor     = ''
  17. lineweight    = ''
  18. linepattern    = ''
  19. linejoin    = ''
  20. FillPattern    = ''
  21.  
  22. attributes.1    = "LineColor"
  23. attributes.1.1    = "_Line Color"
  24. attributes.2    = "LineWeight"
  25. attributes.2.1    = "_Line Weight"
  26. attributes.3    = "LinePattern"
  27. attributes.3.1    = "_Line Pattern"
  28. attributes.4    = "LineJoin"
  29. attributes.4.1    = "_Line Join"
  30. attributes.5    = "FillPattern"
  31. attributes.5.1    = "_Fill Pattern"
  32.  
  33. attr = ''
  34.  
  35. do i = 1 to 5
  36.     attr = attr || cr || attributes.i.1
  37.     interpret compress(attributes.i.1)"=" i
  38. end
  39.  
  40. attr = substr(attr, 2)
  41. attr = pdm_SelectFromList("Select Style Attributes..", 25, 5, 1, attr)
  42. if attr = '' then exit_msg()
  43.  
  44. do while attr ~= ''
  45.  
  46.     parse var attr attribute '0a'x attr
  47.  
  48.     i = value(compress("_"attribute))
  49.     attribute = attributes.i
  50.  
  51.     interpret attribute" = pdm_Get"attribute"()"
  52.  
  53.     if attribute = "FillPattern" then
  54.     do
  55.         parse var fillpattern gradtype '0a'x color1 '0a'x color2 '0a'x steps '0a'x angle '0a'x centerx '0a'x centery
  56.  
  57.         cdef1 = separate(pdm_GetColorData(color1), ',')
  58.         cdef2 = separate(pdm_GetColorData(color2), ',')
  59.  
  60.         fillpattern = gradtype';'cdef1';'color1';'cdef2';'color2';'steps';'angle';'centerx';'centery';'
  61.  
  62.     end
  63.     else if attribute = "LineColor" then
  64.     do
  65.         cdef = separate(pdm_GetColorData(linecolor), ',')
  66.         linecolor = linecolor';'cdef';'
  67.     end
  68.  
  69. end
  70.  
  71. start:
  72.  
  73. /*    ask use for the name of new style and write it to the database    */
  74. stylename = pdm_GetForm("Enter name of style..", 30, "Name")
  75. if stylename = '' then exit_msg()
  76.  
  77. lines = ''
  78.  
  79. if ~exists(styledb) then signal past
  80.  
  81. if ~open(file, styledb, "r") then
  82.     exit_msg("Unable to open styletag database!!")
  83.  
  84.  
  85. call pdm_ShowStatus("Reading style database..")
  86.  
  87. /*    read through entrys to make sure style is not already declared    */
  88. ustylename = upper(stylename)
  89. do while ~eof(file)
  90.  
  91.     line = strip(readln(file))
  92.  
  93.     if line = '' then iterate
  94.  
  95.     parse var line name ';' junk
  96.  
  97.     if upper(name) = ustylename then
  98.     do
  99.         resp = pdm_Inform(3, "The style named: "stylename" has already been defined. Would you like to replace it?", "Cancel", "No", "Yes")
  100.  
  101.         if resp = 0 then
  102.         do
  103.             call close(file)
  104.             exit_msg()
  105.         end
  106.         else if resp = 1 then
  107.         do
  108.                 call close(file)
  109.                 signal start
  110.         end
  111.  
  112.     end
  113.     else
  114.         lines = lines || '0a'x || line
  115.  
  116. end
  117.  
  118. call close(file)
  119.  
  120. past:
  121.  
  122.  
  123. if ~open(file, styledb, "w") then
  124.     exit_msg("Unable to write style to database!!")
  125.  
  126. /*    append current information to lines    */
  127. lines = lines || cr || stylename'@'linecolor'@'lineweight'@'linepattern'@'linejoin'@'fillpattern
  128.  
  129. call writeln(file, lines)
  130. call close(file)
  131. call exit_msg("Done")
  132.  
  133. exit_msg: procedure expose units
  134. do
  135.     parse arg message
  136.  
  137.     if message ~= '' then call pdm_inform(1,message,)
  138.     call pdm_ClearStatus()
  139.     call pdm_SetUnits(units)
  140.     call pdm_AutoUpdate(1)
  141.     exit
  142. end
  143.  
  144. separate: procedure
  145. do
  146.     parse arg string, separator
  147.     string = replacestring(string, ' ', separator, 0)
  148.     return(string)
  149. end
  150.